home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Over 1,000 Windows 95 Programs
/
Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso
/
1256
/
tour010.co_
/
tour010.co
Wrap
Text File
|
1997-04-18
|
12KB
|
305 lines
*---Created with EasyCODE(COB)----------------------------------- # EASY O
*---Last modification: 01.03.1995 14:23:36----------------------- # EASY K
*This program is used to collect data of journeys.
*---------------------------------------------------------------- # EASY *
*---------------------------------------------------------------- # EASY (
*TOUR010
*---------------------------------------------------------------- # EASY *
IDENTIFICATION DIVISION.
*---------------------------------------------------------------- # EASY (
**** Identification Division ***
*---------------------------------------------------------------- # EASY *
PROGRAM-ID. TOUR010.
*
*
* THIS PROGRAM IS USED TO COLLECT THE DATA OF JOURNEYS.
* IT IS DESIGNED TO BE ACTIVATED
*
* 1.) FROM THE MENU USING A MESSAGE OF THE LENGTH 0
* 2.) BY A LINE MESSAGE OF THE LENGTH 0
* OR 4 (THIS WILL BE THE ID OF THE JOURNEY
* FOR WHICH INFORMATION IS TO BE COLLECTED)
* AND
* 3.) BY ITSELF.
*
* ITS TACS : COLLECT (FOR 1ST AND 3RD),
* NEW (FOR 2ND)
*
*
*---------------------------------------------------------------- # EASY )
ENVIRONMENT DIVISION.
DATA DIVISION.
*---------------------------------------------------------------- # EASY (
**** Data Division ***
*---------------------------------------------------------------- # EASY *
*---------------------------------------------------------------- # EASY (
**** WORKING-STORAGE Section ***
*---------------------------------------------------------------- # EASY *
WORKING-STORAGE SECTION.
77 ENTER-KEY PIC X(3) VALUE "000".
77 F1-KEY PIC X(3) VALUE "21Z".
77 K1-KEY PIC X(3) VALUE "24Z".
77 K2-KEY PIC X(3) VALUE "25Z".
77 ERRORMESSAGE-1 PIC X(80) VALUE
"WRONG INPUT DATA - PLEASE RETRY".
77 ERRORMESSAGE-2 PIC X(80) VALUE
"JOURNEY'S ID ALREADY EXISTS - PLEASE USE DIFFERENT ID".
77 ERRORMESSAGE-3 PIC X(80) VALUE
"WRONG KEY - ONLY ENTER OR K1 ALLOWED".
77 RESULTMESSAGE PIC X(80) VALUE
"JOURNEY'S DATA WRITTEN TO FILE".
COPY KCOPC.
COPY KCDFC.
* # EASY S
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** LINKAGE Section ***
*---------------------------------------------------------------- # EASY *
LINKAGE SECTION.
COPY KCKBC.
05 MENU-MESSAGE PIC X(80).
05 NB PIC X(108).
05 COLLECT REDEFINES NB.
COPY COLLECT.
COPY KCPAC.
03 ERROR-LINE.
05 RET-CODE PIC X(3).
05 OCCURRED-AT PIC X(5).
05 OP-CODE PIC X(4).
05 FILLER PIC X(96).
03 JOURNEY.
COPY JOURNEY.
03 PEND-MODE PIC X(2).
03 NEXT-TAC PIC X(8).
03 ERROR-SIGN PIC 9.
* # EASY S
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY )
PROCEDURE DIVISION USING KCKBC KCSPAB.
*---------------------------------------------------------------- # EASY (
**** Procedure Division ***
*---------------------------------------------------------------- # EASY *
*---------------------------------------------------------------- # EASY (
**** INIT-OPERATION ***
*---------------------------------------------------------------- # EASY *
INIT-OPERATION.
MOVE INIT TO KCOP
* # EASY -
MOVE 80 TO KCLKBPRG
* # EASY -
MOVE 1000 TO KCLPAB
CALL "KDCS" USING KCPAC
IF KCRCCC NOT = "000"
THEN
PERFORM ERROR-MPUT-OPERATION
PERFORM ERROR-PEND-OPERATION
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** MGET-OPERATION ***
*---------------------------------------------------------------- # EASY *
MGET-OPERATION.
MOVE MGET TO KCOP
* # EASY -
MOVE 108 TO KCLA
* # EASY -
MOVE "*COLLECT" TO KCMF
CALL "KDCS" USING KCPAC, COLLECT
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** PROCESSING ***
*---------------------------------------------------------------- # EASY *
PROCESSING.
EVALUATE KCRCCC
WHEN "05Z"
PERFORM START-COLLECTING
WHEN K1-TASTE
PERFORM FINISH-COLLECTING
WHEN DUE-TASTE
PERFORM CONTINUE-COLLECTING
WHEN OTHER
IF
KCRCCC NOT < F1-KEY AND
KCRCCC NOT > K2-KEY
THEN
PERFORM REJECT-WRONG-KEY
ELSE
PERFORM ERROR-MPUT-OPERATION,
PERFORM ERROR-PEND-OPERATION
END-IF
END-EVALUATE
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** MPUT-OPERATION ***
*---------------------------------------------------------------- # EASY *
MPUT-OPERATION.
MOVE MPUT TO KCOP
* # EASY -
MOVE "NE" TO KCOM
CALL "KDCS" USING KCPAC, COLLECT
IF KCRCCC > "000"
THEN
PERFORM ERROR-PEND-OPERATION
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** PEND-OPERATION ***
*---------------------------------------------------------------- # EASY *
PEND-OPERATION.
MOVE PEND TO KCOP
* # EASY -
MOVE PEND-MODE TO KCOM
* # EASY -
MOVE NEXT-TAC TO KCRN
CALL "KDCS" USING KCPAC
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** ERROR-PEND-OPERATION ***
*---------------------------------------------------------------- # EASY *
ERROR-PEND-OPERATION.
MOVE PEND TO KCOP
* # EASY -
MOVE "ER" TO KCOM
CALL "KDCS" USING KCPAC
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** ERROR-MPUT-OPERATION ***
*---------------------------------------------------------------- # EASY *
ERROR-MPUT-OPERATION.
MOVE SPACES TO ERROR-LINE
* # EASY -
MOVE KCRCCC TO RET-CODE
* # EASY -
MOVE " AT " TO OCCURRED-AT
* # EASY -
MOVE KCOP TO OP-CODE
* # EASY -
MOVE MPUT TO KCOP
* # EASY -
MOVE "NE" TO KCOM,
MOVE 12 TO KCLM
* # EASY -
MOVE SPACES TO KCMF, KCRN
* # EASY -
MOVE KCALARM TO KCDF
CALL "KDCS" USING KCPAC, ERROR-LINE
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** END-OF-PROGRAM ***
*---------------------------------------------------------------- # EASY *
END-OF-PROGRAM.
EXIT PROGRAM
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** START-COLLECTING ***
*---------------------------------------------------------------- # EASY *
START-COLLECTING.
IF KCRLM NOT = 4
THEN
MOVE ZEROES TO JOURNEY-ID OF COLLECT
END-IF
MOVE SPACES TO WHERETOGO OF COLLECT,
NOTICE OF COLLECT
* # EASY -
MOVE ZEROES TO FREE-SEATS OF COLLECT
PERFORM PREPARE-OUTPUT
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** FINISH-COLLECTING ***
*---------------------------------------------------------------- # EASY *
FINISH-COLLECTING.
MOVE SPACES TO MENU-MESSAGE
* # EASY -
MOVE "MENUOUT" TO KCRN, NEXT-TAC
* # EASY -
MOVE 0 TO KCLM
* # EASY -
MOVE "PR" TO PEND-MODE
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** CONTINUE-COLLECTING ***
*---------------------------------------------------------------- # EASY *
CONTINUE-COLLECTING.
IF
JOURNEY-ID OF COLLECT NOT NUMERIC OR
JOURNEY-ID OF COLLECT = ZERO OR
WHERETOGO OF COLLECT = SPACES OR
FREE-SEATS OF COLLECT NOT NUMERIC OR
FREE-SEATS OF COLLECT = ZERO
THEN
MOVE ERRORMESSAGE-1 TO NOTICE OF COLLECT
ELSE
MOVE CORRESPONDING COLLECT TO MASK OF JOURNEY,
MOVE ZERO TO BOOKED-SEATS OF JOURNEY,
CALL "WRJOURNEY"
USING
JOURNEY, ERROR-SIGN,
IF ERROR-SIGN = ZERO
THEN
MOVE RESULTMESSAGE TO NOTICE OF COLLECT
ELSE
MOVE ERRORMESSAGE-2 TO NOTICE OF COLLECT
END-IF
END-IF
PERFORM PREPARE-OUTPUT
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** REJECT-WRONG-KEY ***
*---------------------------------------------------------------- # EASY *
REJECT-WRONG-KEY.
MOVE ERRORMESSAGE-3 TO NOTICE OF COLLECT
PERFORM PREPARE-OUTPUT
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** PREPARE-OUTPUT ***
*---------------------------------------------------------------- # EASY *
PREPARE-OUTPUT.
MOVE 108 TO KCLM
* # EASY -
MOVE "*COLLECT" TO KCMF
* # EASY -
MOVE SPACES TO KCRN
* # EASY -
MOVE "COLLECT" TO NEXT-TAC
* # EASY -
MOVE "RE" TO PEND-MODE
* # EASY -
MOVE ZERO TO KCDF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY )
END PROGRAM TOUR010.
*---------------------------------------------------------------- # EASY )